
module Main where

import List
import Char
import Control.Monad
import Text.HTML.TagSoup
import Text.HTML.Download
import Maybe

import Network.HTTP
import Network.URI

import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)

{-
    TODO:
    - Follow redirects
-}

data PlayList = PlayList { 
    playListPid :: String,
    playListName :: String,
    playListUrl :: String
} deriving (Show)

split :: Char -> String -> [String]
split = unfoldr . split'

split' :: Char -> String -> Maybe (String, String)
split' c l
    | null l = Nothing
    | otherwise = Just (h, drop 1 t)
    where (h, t) = span (/=c) l

href (TagOpen tag attrs) = lookup "href" attrs

urlParams url =
    let
        params = split '&' $ (split '?' url)!!1
        kv param =
            let
                (k:v:_) = split '=' param
            in
                (k,v)
    in
        map kv params

linkTags tags = filter isTagOpen $ head $ sections (~== ("<a>")) tags

links tags = catMaybes $ map href $ linkTags tags

userPrefixRange url = 
    let
        pmap = urlParams url
    in
        (lookup "umin" pmap,
         lookup "umax" pmap)

getUserRange :: String -> IO String
getUserRange userName = 
    let userInitial = userNameInitial userName
        url = "http://www.seeqpod.com/api/iphone/ukeylist?key=" ++ userInitial
        isMatchingRange :: String -> Bool
        isMatchingRange url' =
            let 
                userPre = take 3 userName
            in
                case userPrefixRange url' of
                    (Just a, Just b) -> (a <= userPre) && (b >= userPre)
                    otherwise -> False
    in do
        src <- getURL url;
        tags <- return $ parseTags src;
        rangeUrl <- return $ head $ 
            filter isMatchingRange $ links tags;
        return rangeUrl;
    
userNameInitial userName = (toUpper $ head userName) : ""

userRangeUrl (umin,umax) =
    concat [
        "http://www.seeqpod.com/api/iphone/ukeylist?umin=",
        umin,
        "&umax=",
        umax]

getUserPage :: String -> IO String
getUserPage userName = do
    usersUrlFrag <- getUserRange userName
    usersUrl <- return $ "http://www.seeqpod.com" ++ usersUrlFrag
    usersSrc <- getURL usersUrl
    tags <- return $ parseTags usersSrc
    userUrl <- return $ 
        "http://www.seeqpod.com" ++ (head $ filter isUserLink $ links tags)
    getURL userUrl
    where
        isUserLink link =
            let params = urlParams link
                linkUser = lookup "uname" params
            in 
                case linkUser of
                    Just user -> user == userName
                    Nothing -> False

getPlayLists userName = do
    userSrc <- getUserPage userName
    tags <- return $ parseTags userSrc
    playlists <- return $ catMaybes $ map getPlayList $ links tags
    return playlists
    where
        getPlayList :: String -> Maybe PlayList
        getPlayList link =
            let params = urlParams link
                name = lookup "name" params
                pid = lookup "pid" params
            in 
                case (name,pid) of
                    (Just name', Just pid') -> 
                        Just $ PlayList pid' name' ("http://www.seeqpod.com" ++ link)
                    otherwise -> Nothing

getPlayListPage playList = do
    getURL $ playListUrl playList

getMp3Links :: PlayList -> IO [String]
getMp3Links playList = do
    src <- getPlayListPage playList
    tags <- return $ parseTags src
    liftM catMaybes $ mapM followRedirectLink $ links tags
    where
        followRedirectLink :: String -> IO (Maybe String)
        followRedirectLink url' = do
            src' <- getURL ("http://www.seeqpod.com" ++ url')
            tags' <- return $ parseTags src'
            case links tags' of
                (x:xs) -> return $ Just x
                _ -> return Nothing
    
err :: String -> IO a
err msg = do 
      hPutStrLn stderr msg
      exitFailure

getURL url = get $ fromJust $ parseURI url

get :: URI -> IO String
get uri =
    do
    eresp <- simpleHTTP (request uri)
    resp <- handleE (err . show) eresp
    case rspCode resp of
                      (2,0,0) -> return (rspBody resp)
                      (3,_,_) -> return (rspBody resp) -- TODO: follow redir
                      _ -> err (httpError resp)
    where
    showRspCode (a,b,c) = map intToDigit [a,b,c]
    httpError resp = showRspCode (rspCode resp) ++ " " ++ rspReason resp

request :: URI -> Request
request uri = Request{ rqURI = uri,
                       rqMethod = GET,
                       rqHeaders = [],
                       rqBody = "" }

handleE :: Monad m => (ConnError -> m a) -> Either ConnError a -> m a
handleE h (Left e) = h e
handleE _ (Right v) = return v

main :: IO ()
main = do
    args <- getArgs
    case args of
        (userName:[]) -> printPlayLists userName
        (userName:playList:[]) -> downloadPlayList userName playList
        _ -> printHelp

printHelp = do
    putStrLn "Coming Soon..."

printPlayLists userName = do
    playLists <- getPlayLists userName
    mapM putStrLn $ map playListName playLists
    return ()

downloadPlayList userName playListName' = do
    playLists <- getPlayLists userName
    case filter (\x -> playListName x == playListName') playLists of
        (playList:xs) -> do
            mp3Links <- getMp3Links playList
            mapM_ putStrLn $ mp3Links
        _ -> return ()
